Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/sightmap/auxprocs.bas

BASIC Source File | 1999-02-24 | 8KB | 307 lines

Attribute VB_Name = "auxProcs"
Option Explicit

'MODULE -- auxProcs -- auxProcs.bas

'--------------------------------------------------------------------------
'<Purpose>
'       Provide helper functions and procedures to the application.
'
'--------------------------------------------------------------------------

Public gSites As New Collection
Public gLoadingSite As Boolean
Private mRow As Integer

'--------------------------------------------------------------------------
'<Purpose>
'   Interrogate the source directory for files matching the file masks.
'   Recursive if indicated by blnRecurse.
'
'<Syntax>
'   FindFiles(TRUE, Path, Filter, SiteID)
'
'<Assumptions>
'   There is at least one filter defined, and the path is a valid path.
'
'<Returns>
'   Nothing.  The file list is placed in a global class variable.
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------
Public Sub FindFiles(ByVal blnRecurse As Boolean, _
        ByVal strPath As String, ByVal strFilter As String, ByVal intSiteID)

On Error GoTo FindFiles_Err

Dim intFileCount             As Integer
Dim blnStop                  As Boolean
Dim strFile                  As String
Dim intResult                As Integer
Dim strDirectories()         As String
Dim intDirCount              As Integer
Dim intDirSearch             As Integer

    intFileCount = gSites(intSiteID).FileCount
    intDirCount = 0

    ReDim strDirectories(0)

    strFile = Dir(strPath & "\" & "*" & strFilter)
    Do While strFile <> ""
        intFileCount = intFileCount + 1
        gSites(intSiteID).FileCount = gSites(intSiteID).FileCount + 1
        gSites(intSiteID).FileEntry(intFileCount) = strPath & "\" & UCase$(strFile)
        strFile = Dir
    Loop

    If blnRecurse Then
        'Build list of directories
        strFile = Dir(strPath & "\*.*", vbDirectory)
        Do While (strFile <> "")
            If strFile <> "." And strFile <> ".." Then
                intResult = GetAttr(strPath & "\" & strFile) And vbDirectory
                If intResult <> 0 Then
                    intDirCount = intDirCount + 1
                    ReDim Preserve strDirectories(intDirCount)
                    strDirectories(intDirCount - 1) = strFile
                End If
            End If
            strFile = Dir
        Loop

        'Recurse through all directories
        For intDirSearch = 0 To intDirCount - 1
            Call FindFiles(True, strPath & "\" & strDirectories(intDirSearch), strFilter, intSiteID)
        Next intDirSearch

        'Reset list for recursion unwinding
        Erase strDirectories
        ReDim strDirectories(0)
        intDirCount = 0

    End If

Exit Sub
FindFiles_Err:

    MsgBox CStr(Err.Number) & " -- " & Err.Description, vbCritical, "RegArbiter"

End Sub

'--------------------------------------------------------------------------
'<Purpose>
'   Create a new instance of Site for use.
'
'<Syntax>
'   AddSite(SiteID)
'
'<Assumptions>
'   None.
'
'<Returns>
'   Nothing.  The new site is added to a global collection variable, gSites
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------

Public Sub AddSite(NewID As String)

Dim NewSite As New Site
Dim id As String

    'get a random id
    id = CStr(Int((10000 - 1 + 1) * Rnd + 10000))

    NewID = id

    With NewSite
        .SiteID = id
        .FilterCount = 2
        .FilterEntry(1) = "asp"
        .FilterEntry(2) = "htm"
    End With

    gSites.Add NewSite, id

End Sub
'--------------------------------------------------------------------------
'<Purpose>
'   Builds an adjacency matrix and other lists to help diagram the site.
'
'<Syntax>
'   MapMe(SiteID)
'
'<Assumptions>
'   A file list has been provided.
'
'<Returns>
'   Nothing.  The matrix is stored in the Class variable.
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------
Public Sub MapMe(ByVal SiteID As String)

Dim sb As StatusBar


    Set sb = frmMain.sbMain
    sb.SimpleText = "Building Adjacency Matrix"
    gSites(SiteID).BuildMatrix
    sb.SimpleText = ""

End Sub

'--------------------------------------------------------------------------
'<Purpose>
'   Loads a site's info from a loaded Site class.
'
'<Syntax>
'   LoadSiteForm(frm, S)
'
'<Assumptions>
'   The site has been loaded from disk into S, frm is a loaded
'   instance of frmSiteDefinition.
'
'<Returns>
'   Nothing.
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------
Sub LoadSiteForm(frm As frmSiteDefinition, S As Site)
Dim i As Integer

    frm!lblSiteName = S.SiteName
    frm!lblDirectory = S.MainDirectory

    For i = 1 To S.FilterCount
        frm!lblFileMasks = frm!lblFileMasks & "  " & S.FilterEntry(i)
    Next

    For i = 1 To S.FileCount
        frm!lstFiles.AddItem S.FileEntry(i)
    Next

    frm!txtRoot = S.Root

    frm.mSiteID = S.SiteID

    If S.ChooseRoot Then
        frm!optDefine = True
    Else
        frm!optDivined = True
    End If

End Sub
'--------------------------------------------------------------------------
'<Purpose>
'   Recursively creates a treeview node structure from the adjacency lists.
'
'<Syntax>
'   MakeExcelFile(tv)
'
'<Assumptions>
'   The class has a valid matrix.
'
'<Returns>
'   Handle to the built treeview control.
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------
Sub MakeExcelFile(tv As TreeView)

Dim xl As Excel.Application
Dim n As Node

    'Initialize global row counter
    mRow = 1

    'Open a new version of Excel
    Set xl = New Excel.Application

    'show excel and add a new workbook
    xl.Visible = True
    xl.Workbooks.Add

    'set recursion loop invariant to first (root) node
    Set n = tv.Nodes.Item(1)

    'set root node value
    xl.Range(("A1")).Value = n.Text

    'Kick the recursion off, printing in depth first manner
    Call TraverseChildren(tv, n, xl, 1)

    'Release excel object
    Set xl = Nothing

End Sub
'--------------------------------------------------------------------------
'<Purpose>
'   Performs the recursion of exploding each child and inserting the
'   children correctly
'
'<Syntax>
'   TraverseChildren(TreeViewCtl, CurrentNode, ExcelInstance, CurrentCol)
'
'<Assumptions>
'   None.
'
'<Returns>
'   None.
'
'<Author>
'   HBW
'
'--------------------------------------------------------------------------
Sub TraverseChildren(tv As TreeView, n As Node, _
    xl As Excel.Application, Depth As Integer)

'Recursive

Dim i As Integer        'lcv pointing to current child
Dim CellCol As String   'horizontal positioning for printing to excel

    'which column are we currently on for this recursion?
    CellCol = Chr(Depth + 65)

    'If we have no children, exit
    If n.Children > 0 Then
        'set i to the index of the first child
        i = n.Child.Index
        'increase the row count
        mRow = mRow + 1
        'output the value to the correct cell
        xl.Range((CellCol & mRow)).Value = n.Child.Text

        'Recurse with the first child
        Call TraverseChildren(tv, tv.Nodes(i), xl, Depth + 1)

        While i <> n.Child.LastSibling.Index
        'if there are more children, process in order, depth first
            'increase the row count
            mRow = mRow + 1
            'output the value to the correct cell
            xl.Range((CellCol & mRow)).Value = tv.Nodes(i).Next.Text
            'advance the index to the next child
            i = tv.Nodes(i).Next.Index
            'Recurse with subsequent children
            Call TraverseChildren(tv, tv.Nodes(i), xl, Depth + 1)
        Wend

    End If

End Sub